perm filename TAPSCR.F4[TAP,LCS]1 blob sn#337850 filedate 1978-02-26 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C   THIS IS FOR RHYTHMIC INPUT FROM TTY KEYBOARD.
C00017 ENDMK
CāŠ—;
C   THIS IS FOR RHYTHMIC INPUT FROM TTY KEYBOARD.
C   ORDER FOR EDITING WITH 'CONDUCT'.
C   1. GET LISTING.   2. ADD,DELETE,CHANGE DURATIONS,TEMPO,METER.   
C   3. QUICK TEMPO CHANGES MUST COME LAST!

	DIMENSION IV(200),V(200),W(600),VV(5),RV(8),JV(25)
	COMMON V,N
	EQUIVALENCE (VV1,VV(1)),(VV2,VV(2)),(VV3,VV(3))
	1 ,(VV4,VV(4)),(VV5,VV(5)),(JV,RV,IV)
1032	TYPE 1000
32	X=0
	I=1
	J=1
	JOUT=5
C 5 = OUTPUT TO TTY
1000	FORMAT(' INFO? OR WHAT?'/)
	ACCEPT 50,N,NN
50	FORMAT(2A1)
	IF(N.NE.'I')GO TO 2000
	TYPE 2000
	GO TO 1032
2000	FORMAT
	1(' COMMANDS: <CR>=TAP, C(ONDUCT), L(IST), LR=LIST RHYTHM,
	1 LP=LIST ON LPT'/' S(AVE A FILE), R(EAD AN OLD FILE),
	1 E(DIT)'/' ALL RESTS, AS WELL AS NOTES, MUST BE 
	1 TAPPED.'/)
	IF(N.EQ.'L')GO TO 24
	IF((N.EQ.'R').OR.(N.EQ.'S'))GO TO 6
	IF(N.EQ.'E')GO TO 1013
	IF(N.EQ.'C')TYPE 209
3001	TYPE 1001
209	FORMAT(' CONDUCTOR MUST GIVE UPBEAT.')
1001	FORMAT(' TAP ON CNTRL OR META.  END WITH "TOP"'/)
	DO 2001 K=1,200
2001	V(K)=0
	CALL TAP(V)
CC	DO 2001 K=II+1,200
CC2001	V(K)=0
	A=0
	L=1
	IF(N.EQ.'C')L=2
	DO 1021 K=L,200
	IF(V(K).EQ.0)GO TO 3021
1021	A=A+V(K)
2021	FORMAT(I4,' TAPS ',F8.3,'"'/)
	K=201
3021	L=K-1
	II=L
	IF(N.EQ.'C')L=L-1
CCC	IF(N.EQ.'C')L=L-1
	TYPE 2021,L,A
21	FORMAT(2F)
	TYPE 12
12	FORMAT(' <CR>=OK, 1=TRY AGAIN, L=LIST'/)
	ACCEPT 5,K
	ICON=0
	IF(K.EQ.1)GO TO 3001
	REREAD 50,K,NN
C YOU CAN TYPE L FOR LIST AT THIS POINT.
	IF(N.NE.'C')GO TO 4012
C   WHEN 'CONDUCTING', UPBEAT MUST BE TAPPED.
C   METER OF UPBEAT (NOTE #0) MAY BE RESET.
	ALLM=1.
	ICON=-1
3012	Q=ALLM
	DO 2012 KA=3,II*3,3
2012	W(KA)=Q
	IF(ALLM.EQ.X)GO TO 300
4012	IF(K.NE.'L')GO TO 1032
	N='L'
24	IF(NN.EQ.'P')JOUT=3
C 3 = OUTPUT TO LPT   (TYPE LP)
	IF(ICON)GO TO 100
9024	N=0
7024	FORMAT(/' DURATIONS OF TAPS',18XA5,'  TOTAL=',F7.3,' SECS.'/)
8024	FORMAT(' NOTE 0 IS UPBEAT (NOT INCLUDED IN DURATION)')
315	FORMAT(' HOW MANY(K) NTHS IN FIRST TAP?  TYPE K AND N. '$)
	RHY=0
	IF(NN.NE.'R')GO TO 215
	TYPE 315
	ACCEPT 21,RHY,VVV
	IF(VVV.EQ.0)VVV=16
	RHY=V(1)*VVV/RHY
215	L=1
	K=1
	IF(ICON)K=0
	WRITE(JOUT,7024),QSLAC,A
	IF(ICON)WRITE(JOUT, 8024)
	DO 14 LL=1,40
	KA=K+1
	KB=KA+1
	KC=KB+1
	KD=KC+1
	DO 115 KK=0,4
	VVV=V(L+KK)
	IF(RHY.GT.0)VVV=RHY/VVV
C CONVERTS TO RHYTHMIC DENOMINATORS
115	VV(KK+1)=VVV
	WRITE(JOUT,15)K,VV1,KA,VV2,KB,VV3,KC,VV4,KD,VV5
	DO 16 M=1,5
	B=V(L+M+1)
	IF(B.EQ.0.OR.B.EQ.999.0)GO TO 15
16	CONTINUE
	L=L+5
14	K=K+5
15	FORMAT(5(' (',I3,')',F7.3)/)
	IF(JOUT.EQ.5)GO TO 1032
	CALL EXIT

1013	TYPE 17
	IF(ICON.GE.0)GO TO 17
	IF(ICON.EQ.-2)Q=W(3)
C GETS FIRST METER INDICATION.
	ICON=-1
17	FORMAT(' TYPE C(HANGE),A(DD NOTE),D(ELETE),T(EMPO CHANGE),
	1M(ETER CHANGE),Q(UICK CHANGE), OR <CR>'/)
	ACCEPT 50,K
	IF(K.EQ.'-1')GO TO 1013
C   WITH 'CONDUCT', ADDED BEATS ARE IN TERMS OF REAL TIME.
	IF(K.EQ.'M')GO TO 101
	IF((K.NE.'C').AND.(K.NE.'Q'))GO TO 18
	TYPE 19
19	FORMAT(' TYPE NOTE N'/)
 	ACCEPT 5,KA
	IF(KA)GO TO 1013
	IF(K.EQ.'Q')GO TO 120
	L=KA
	IF(ICON)KA=KA+1
	TYPE 20,L,V(KA)
20	FORMAT(' NOTE',I3,' WAS',F9.4,', CHANGE TO ',$)
	X=V(KA)
	ACCEPT 21,V(KA)
	IF(V(KA).LE.0)V(KA)=X
	A=A+V(KA)-X
	IF(ICON+1)GO TO 300
	GO TO 1013
220	FORMAT(' BEAT',I3,', TF1=',F5.3,', TF2=',F5.3,/
	1 ' CHANGE TF1 TO ',$)
120	L=KA*3+1
	TYPE 220,KA,W(L),W(L+1)
	ACCEPT 21,Y
	IF(Y.LE.0)GO TO 1013
	X=W(L+1)+W(L)-Y
	W(L)=Y
	W(L+1)=X
	KA=KA+2
	LA=L+2
	GO TO 1300
C   QUICK CHANGES MUST BE DONE LAST. THEY ARE WIPED OUT WHEN ANY OTHER EDITING IS DONE!
C   THEY MUST BE IN ORDER FROM 1 TO END.

18	IF(K.NE.'A')GO TO 22
	TYPE 23
23	FORMAT(' ADD AFTER WHICH NOTE?'/)
	ACCEPT 5,K
	IF(K)GO TO 1013
	IF(ICON)K=K+1
	TYPE 25
25	FORMAT(' TYPE NOTE VALUE'/)
	ACCEPT 21,X
	IF(X.LE.0)GO TO 18
	A=A+X
	II=II+1
	IF(ICON)W((II-1)*3)=1.
	L=II+10
	DO 26 M=L,1,-1
	V(M)=V(M-1)
	IF(M-1.NE.K)GO TO 26
	V(M)=X
C   'METERS' MUST BE CHECKED AFTER 'ADD' OR 'DELETE' IS USED.
	IF(ICON)GO TO 2300
	GO TO 1013
26	CONTINUE
	GO TO 1032

22	IF(K.NE.'D')GO TO 35
	TYPE 28
28	FORMAT(' DELETE WHICH NOTE?'/)
 	ACCEPT 5,K
	IF(K)GO TO 1013
	IF(ICON)K=K+1
	II=II-1
	A=A-V(K)
	DO 29 KA=K,II-1
29	V(KA)=V(KA+1)
	IF(ICON)GO TO 2300
	GO TO 1013

410	KB=II
	KC=II
	KA=1
	KX=4
CC1410	G=3.9
CC	MM=234
CC	ICNT=1
1410	KD=36
	IF(JOUT.EQ.3)KD=51
	IF(KB.GT.KD)KB=KD
	KC=KC-KB
	KD=KB*2
	X=0
	GY=10
C NEXT SETS UP RANGE OF CONDUCT GRAPH
	LL=KX+KB*3
	DO 5201 K=KX,LL,3
C W(1)=980000  W(2)=WDCNT
	DO 6201 MM=K,K+1
	Y=W(MM)
	IF(Y.GT.X)X=Y
6201	IF(Y.LT.GY)GY=Y
5201	IF(W(K+2).EQ.999)GO TO 7201
7201	MM=60*GY
	MM=(MM/6)*6+6
C SETS BOTTOM LIMIT OF MM NUMBS.
	GY=MM/60.
	MM=60*X
	MM=(MM/6)*6
C SETS TOP LIMIT (+1)
	G=MM/60.
	KX=LL+3
	LL='9'
310	KK=9
	L=-1
C   WATCH ARRAY LENGTHS HERE.
	J=KB
	IF(KA.GT.1)J=J+3
	DO 210 K=KA*3+1,(J+KA-1)*3-1,3
	X=W(K)
	Y=W(K+1)
	L=L+2
	IV(L)='. ' 
	IV(L+1)=' '
	IF(L.NE.KK)GO TO 1210
2210	IV(L)=-2147483648
	KK=KK+10
1210	IF((Y.LT.G+.05).AND.(Y.GT.G-.05))IV(L+1)=LL
210	IF((X.LT.G+.05).AND.(X.GT.G-.05))IV(L)=LL
CC	X='  ' 
CC	IF(ICNT.EQ.10)X=' 180' 
CC	IF(ICNT.EQ.15)X=' 150' 
CC	IF(ICNT.EQ.20)X=' 120' 
CC	IF(ICNT.EQ.30)X='  60' 
CC	IF(ICNT.EQ.25)X='  90' 
CC	IF(ICNT.EQ.5)X=' 210' 
CC	IF(ICNT.EQ.33)X='  42' 
	WRITE(JOUT,110)MM,G,(IV(K),K=1,KD)
CC	ICNT=ICNT+1
110	FORMAT(I4,F5.1,2X102A1)
	IF(G.LT.GY)GO TO 510
	MM=MM-6
	G=G-.1
	LL=LL-536870912
C   ABOVE MOVES '9' TO '0' ETC.
	IF(LL.LT.'0')LL='9'
	GO TO 310
510	IF(KA-2)LB='A'
	IF(LB.GE.'A')LB=LB-536870912
	LL=1
	Y=0
	M=(KB+KA-1)*3
	IF(M-KA*3.GE.150)M=M-1
	DO 610 K=KA*3,M,3
	IV(LL)=' '
	X=W(K)
	IF(X.EQ.1.)GO TO 610
	IF(X.EQ.Y)GO TO 1610
	LB=LB+536870912
	Y=X
1610	IV(LL)=LB
610	LL=LL+1
	IV(LL)=' '
C  WHAT IF LAST BEAT IS NOT 4 16THS?
	KD=KB-KA*(1/KA)
	WRITE(JOUT,710)(IV(K),K=1,KD)
710	FORMAT(11X50A2)
C   200 BEAT LIMIT SO FAR.
	LL='A'
	X=1.
	LA=0
	DO 910 K=KA*3,M-1,3
	Y=W(K)
	L=Y/.25
	IF((Y.EQ.X).OR.(Y.EQ.1.).OR.(L.EQ.LA))GO TO 910
	LA=L
	WRITE(JOUT,1110)LL,L
	LL=LL+536879012
910	X=Y
	IF(KC.LE.0)GO TO 9024
	KA=KB+KA-1
C  CHECK THIS OUT!!
	KB=KC
	WRITE(JOUT,2410)
	GO TO 1410
2410	FORMAT(/  )
1110	FORMAT(1XA1,'=',I2,' 16TH NOTES')
35	FORMAT(' TEMPO FACTOR IS 1, CHANGE TO'/)
	IF(K.NE.'T')GO TO 1032
	TYPE 35
	ACCEPT 21,X
	IF(X)GO TO 1013
	A=0
	IF(ICON)A=-V(1)/X
	DO 36 K=1,II
	V(K)=V(K)/X
36	A=A+V(K)
	IF(ICON)GO TO 2300
	GO TO 1032

100	IF(ICON+1)GO TO 410
2300	W(1)=980000.
300	W(2)=II*3-2
	KA=2
	LA=3
	X=Q/V(1)
1300	L=LA
	DO 1200 K=KA,II
	Y=W(L)/V(K)
	W(L+1)=Y
	W(L+2)=Y
1200	L=L+3
	L=LA
3300	DO 500 K=KA,II
	Y=W(L)/V(K)
	Z=Y
	IF(K.LT.II)Z=W(L+4)
	B=ABS(Y-X)
	C=ABS(Z-Y)
	D=B-C/2
	IF(Y-X)GO TO 700
	IF(Z-Y)GO TO 900
	IF(D)GO TO 600
	IF(C.GE..05)B=-D
	IF(C.LT..05)B=-B*.1
C   '.1' IS ARBITRARY.  TO SMOOTH JUMPS IN TEMPO.
	GO TO 200
700	IF(Z-Y.LE.0)GO TO 800
	B=B*.5
	GO TO 200
800	IF(D)GO TO 200
	IF(C.GE..05)B=D
	IF(C.LT..05)B=B*.1
	GO TO 200
900	B=-B*.5
	GO TO 200
600	B=-B
200	W(L+1)=W(L+1)+B
	W(L+2)=W(L+2)-B
	X=W(L+2)
500	L=L+3

	L=L-1
	DO 2100 K=1,7
2100	W(L+K)=999.
	ICON=-2
	IF(N.EQ.'L')GO TO 410
	IF(N.EQ.'E')GO TO 1013
	GO TO 2

CCC101	FORMAT(' CHANGE WHICH BEAT?'/)
101	FORMAT(' TYPE TAP NUMBER AND NEW VALUE'/)
	TYPE 101
CCC	ACCEPT 5,KA
	ACCEPT 201,KA,RV
C   I.E.  3/8 = 4,8 OR 4. (DOT);   5/16 = 4,16     3/16=8. (DOT)
CCC	TYPE 201
CCC201	FORMAT(' TYPE VALUE OF BEAT'/)
201	FORMAT(I,8F)
	X=0
CCC	ACCEPT 5,(IV(K),K=1,8)
	DO 301 K=1,8
	Y=RV(K)
CC	IF(Y.LT.99.)GO TO 301
CC	ALLM=X
CC	GO TO 3012
C   SETS METER FOR ALL BEATS IF LAST NUMBER IS .GE.99.
301	IF(Y.NE.0)X=X+4./Y
	REREAD 2201,JV
	IDOT=0
	MM=0
	DO 3201 K=1,25
C FINDS DOTTED VALUES FOR METER CHANGE.
	 IF(JV(K).EQ.'A')MM=-1
C TYPE 'ALL' FOR OVER ALL METER CHANGE.
3201	IF(JV(K).EQ.'.')IDOT=IDOT+1
	Y=X
4201	IF(IDOT.EQ.0)GO TO 1201
C JUMP IF NO DOTS
	Y=Y/2
	X=X+Y
	IDOT=IDOT-1
	GO TO 4201
1201	IF(MM)GO TO 8201
	W(KA*3)=X
	GO TO 300
8201	ALLM=X
	GO TO 3012
2201	FORMAT(25A1)
C   FIX SO CHANGES GO FROM THIS POINT ON.
CC  THE NEXT WILL BE OUT.
CX	W(L+2)=(X/V(KA-1)-Y)*2+Y
CX	W(L+4)=W(L+2)
C   QUICK CHANGES OF TEMPO MUST BE SET (OR RESET) AFTER! ANY METER CHANGE.
CX	GO TO 1013
6	TYPE 2
	IF(N.EQ.'R')ICON=0
	IF(ICON.EQ.-1)GO TO 100
2	FORMAT(' TYPE FILE NAME'/)
	ACCEPT 4,QSLAC
	IF(QSLAC.EQ.'-1')GO TO 1032
	IF(QSLAC.NE.' ')GO TO 4
	QSLAC='TAP'
4	FORMAT(A5)
5	FORMAT(8I)
CC	CALL ZERPP
	IF(ICON)GO TO 1005
	IF(N.EQ.'R') GO TO 27
	DO 102 K=1,II+10
102	W(K)=V(K)
1005	CALL OFILE(1,QSLAC)
10	DO 7 K=1,7
	IF(W(I).EQ.0)W(I)=999.0
7	I=I+1
8	WRITE(1,11)(W(K),K=J,J+6)
	IF((W(I-1).EQ.999.0).OR.(W(I-1).EQ.0))GO TO 9
	J=I
	GO TO 10
C  'V' KEEPS BASIC DATA AT ALL TIMES, 'W' WILL HAVE MODIFIED DATA.(98000,WDCNT,TDUR,T1,T2,ETC.)
9	WRITE(1)II,A,V,Q
	TYPE 109,QSLAC
	END FILE 1
	CALL EXIT
109	FORMAT(' *****TAPS SAVED IN*****   ',A5,'.DAT')
27	CALL IFILE(1,QSLAC)
30	READ(1,11)(W(K),K=J,J+6)
 	IF(W(J+6).EQ.999.0)GO TO 6013
	J=J+7
	GO TO 30
6013	READ(1)II,A,V,Q
	IF(W(1).GT.999.)ICON=-2
	GO TO 1032
11	FORMAT(1X7F)
	END